perm filename HDR[XGP,BGB] blob
sn#038135 filedate 1973-05-11 generic text, type T, neo UTF8
COMMENT ⊗ VALID 00004 PAGES
RECORD PAGE DESCRIPTION
00001 00001
00002 00002 MACROS TO MAKE FAIL EASIER
00007 00003 HERE LIE THE ROUTINES TO PUSH AND POP ACCUMULATORS (STOLEN FROM MONITER)
00009 00004 OPDEFS
00010 ENDMK
⊗;
;MACROS TO MAKE FAIL EASIER
DEFINE CAT $(A,B){A$B}
↓P←←17
FOR @$ I←0,16
< AC.$I←I
>
$←400000
.PLEVEL←←0
.SLEVEL←←0
;SUBROUTINE DECLARATIONS. MAKES MACROS FOR SYMBOLS REPRESENTING ARGUMENTS
DEFINE NSUBR(NAME,X1,X2,X3,X4,X5)
{ BEGIN NAME
INTERN NAME
GLOBAL .PLEVEL
GLOBAL .SLEVEL
.SLEVEL←←.SLEVEL+1
CAT(.SBR,→.SLEVEL)←←.PLEVEL
.PLEVEL←←.PLEVEL+1
IFDIF <><X1>{ DEFARG(X1,→.PLEVEL)
.PLEVEL←.PLEVEL+1
IFDIF <><X2>{ DEFARG(X2,→.PLEVEL)
.PLEVEL←.PLEVEL+1
IFDIF <><X3>{ DEFARG(X3,→.PLEVEL)
.PLEVEL←.PLEVEL+1
IFDIF <><X4>{ DEFARG(X4,→.PLEVEL)
.PLEVEL←.PLEVEL+1
IFDIF <><X5>{ DEFARG(X5,→.PLEVEL)
.PLEVEL←.PLEVEL+1
}}}}}
↓NAME: ;}
;DEFINE AN ARGUMENT
DEFINE DEFARG(NAME,LEVEL)
{ DEFINE NAME { LEVEL-.PLEVEL(17)}}
;END OF SUBROUTINE
DEFINE SUBREND
{ .PLEVEL←←CAT(.SBR,→.SLEVEL)
.SLEVEL←←.SLEVEL-1
BLOCK 0
BEND }
;GENERATE SUBROUTINE CALL (DOES THE RIGHT THING WITH SYMBOLIC ARGUEMENTS)
DEFINE CALL(NAME,X1,X2,X3,X4,X5)
{ GLOBAL .SLEVEL,.PLEVEL
.SLEVEL←←.SLEVEL+1
CAT(.SBR,→.SLEVEL)←←.PLEVEL
IFDIF <><X1>{PUSH 17,X1↔.PLEVEL←.PLEVEL+1
IFDIF <><X2>{PUSH 17,X2↔.PLEVEL←.PLEVEL+1
IFDIF <><X3>{PUSH 17,X3↔.PLEVEL←.PLEVEL+1
IFDIF <><X4>{PUSH 17,X4↔.PLEVEL←.PLEVEL+1
IFDIF <><X5>{PUSH 17,X5↔.PLEVEL←.PLEVEL+1
}}}}}
PUSHJ P,NAME
.PLEVEL←←CAT(.SBR,→.SLEVEL)
.SLEVEL←←.SLEVEL-1
}
;PUSH SOMETHING ONTO STACK
DEFINE PUSHP(ARG)
< PUSH P,ARG
.PLEVEL←←.PLEVEL+1
>
DEFINE POPP(ARG)
< POP P,ARG
.PLEVEL←←.PLEVEL-1
>
DEFINE SETQ(VAR,LIST){CALL(LIST)↔DAC 1,VAR}
;RETURN FROM AN N-ARGUMENT SUBROUTINE CALL.
IFNDEF POP0J
< DEFINE POP0J <POPJ 17,>
↓POP1J.:SUB 17,[XWD 2,2]↔JRST@2(17)↔DEFINE POP1J<JRST POP1J.>
↓POP2J.:SUB 17,[XWD 3,3]↔JRST@3(17)↔DEFINE POP2J<JRST POP2J.>
↓POP3J.:SUB 17,[XWD 4,4]↔JRST@4(17)↔DEFINE POP3J<JRST POP3J.>
↓POP4J.:SUB 17,[XWD 5,5]↔JRST@5(17)↔DEFINE POP4J<JRST POP4J.>
>
;ACCUMULATOR AND TEMPORARY DATA MANAGEMENT.
; FOR @$ I←0,17{↓AC$I:0↔}
; DEFINE SAVAC $(N){LAC[XWD 2,AC2]↔BLT AC$N}
; DEFINE GETAC (N){LAC[XWD AC,2]↔BLT N}
DEFINE ACCUMULATORS(LIST){ACPTR←←2
FOR AC⊂(LIST)<AC←ACPTR
ACPTR←←ACPTR+1↔>}
DEFINE DECLARE (LIST){
FOR VARNAM⊂(LIST)<VARNAM: 0↔>}
;FATAL ERROR MESSAGE.
IFNDEF FATAL.
< DEFINE FATAL(STR){PUSHJ 17,FATAL.↔JFCL [ASCIZ/STR/]}
FATAL.:OUTSTR[BYTE(7)15,12,106,101,124↔"AL - "⊗1↔0]
PUSH P,1↔MOVE 1,@-1(P)↔OUTSTR (1)↔OUTSTR[ASCIZ/
/]↔ POP P,1↔INCHRW↔JRST .-1↔LIT
>
DEFINE CRLF{OUTSTR[BYTE(7)15,12]}
;CHAIN TOGETHER INITIALIZING CODE
DEFINE INITCODE
<IFAVL .INITLINK
< GLOBAL .INITLINK
PUSHJ P,.+2
JRST .INITLINK
↑.INITLINK←←.-2
;> ↑.INITLINK←←.
>
;CHAIN TOGETHER BIT TABLES
DEFINE BITDEFS(BITS)
<IFNDEF .BTLNK < .BTLNK←←0
;> .BTLNK
.BTLNK←←.BTLNK*1000000+$.
.BTABL←←$.
FOR BIT⊂(BITS)
<IFIDN <><BIT>< 0
;> RADIX50 0,BIT
> BLOCK =36+.BTABL-$.
>
DEFINE TAIL
<DOINIT:
IFDEF .INITLINK < PUSHJ P,.INITLINK
> IFDEF .BTLNK < EXTERNAL $M
MOVE [.BTLNK]
SKIPE [$M]
MOVEM $M+3
POP0J
>>
;;HERE LIE THE ROUTINES TO PUSH AND POP ACCUMULATORS (STOLEN FROM MONITER)
IFNDEF PUSHIT<
DEFINE PUSHACS
< PUSHJ P,PUSHIT
GLOBAL .PLEVEL
.PLEVEL←←.PLEVEL+20
>
DEFINE POPACS
< PUSHJ P,POPIT
GLOBAL .PLEVEL
.PLEVEL←←.PLEVEL-20
>
↑↑PUSHIT:
PUSH P,0 ; SAVE 0
HLRE 0,P ; PICK UP COUNT
ADDI 0,20 ; ADD IN DISPLACEMENT
XOR 0,P ; IF SIGNS ARE DIFFERENT, NOT ENOUGH STACK
JUMPGE 0,PUSHOK
POP P,0 ; CAN'T DO IT, LOSE BIG
OUTSTR [ASCIZ ⊗NOT ENOUGH ROOM TO PUSH ACS!!
⊗]
SKIPN JOBDDT
JRST [ OUTSTR[ASCIZ⊗YOU LOSE. ⊗]
HALT PUSHIT ]
↑↑DDTGO:OUTSTR[ASCIZ⊗YOU'RE IN DDT
⊗]
POP P,JOBOPC
JRST @JOBDDT
PUSHOK: POP P,0 ; GET BACK 0
EXCH 0,(P) ;SAVE 0 AND GET RETURN.
MOVEM 0,20(P) ;GEE, THIS WAY WE RETURN WITH A POPJ
MOVEI 0,1(P)
HRLI 0,1
BLT 0,17(P)
ADD P,[XWD 20,20]
POPJ P, ;RETURN TO SENDER
↑↑POPIT:
MOVSI 0,-17(P)
HRRI 0,1
BLT 0,17
MOVE 0,20(P)
EXCH 0,(P)
POPJ P,
>
;OPDEFS
;ONE OF BGB'S WHICH I LIKE
OPDEF GO [JRST]
;MAKE RAID KNOW THE FOLLOWING
OPDEF FIX [FIX]
OPDEF INCHWL [INCHWL]
OPDEF OUTCHR [OUTCHR]
OPDEF OUTSTR [OUTSTR]
OPDEF HALT [HALT]
OPDEF JRSTF [JRST 2,]
OPDEF PGCLR [PGIOT 2,]
IODEND←←20000
EXTERNAL JOBFF,JOBREL,JOBSA,JOBREN,JOBSYM,JOBDDT,JOBOPC